home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbexport.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-28  |  29.4 KB  |  785 lines
  1. (*===========================================================================*)
  2. (* EXPORT msg command                                                        *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$UNDEF  DEBUG_1}
  10. {$UNDEF  DEBUG_FILE}
  11. {$UNDEF  DEBUG_FILE2}
  12.  
  13. {$O+}
  14.  
  15. UNIT BBEXPORT;
  16.  
  17. INTERFACE
  18.  
  19.   USES
  20.     bbfwdd;
  21.  
  22.   PROCEDURE export_cmd(cmd_string : STRING; this_path : path_block_ptr);
  23.  
  24. IMPLEMENTATION
  25.  
  26. USES
  27.   DOS,
  28.   bbdummy,
  29.   bbkmc,
  30.   bbmdata,
  31.   bbmess,
  32.   bbmf,
  33.   bbmisc,
  34.   bbmisc2,
  35.   bbmisc4,
  36.   bbmisc5,
  37.   bbmmsgn,
  38.   bbsdata,
  39.   bbsearch,
  40.   bbsema2,
  41.   bbstr,
  42.   bbtask,
  43.   bbtime;
  44.  
  45. (*===========================================================================*)
  46. (* Export command                                                            *)
  47. (*===========================================================================*)
  48.  
  49. PROCEDURE export_cmd(cmd_string : STRING; this_path : path_block_ptr);
  50.  
  51.   VAR
  52.     add_header   : BOOLEAN;
  53.     b            : BOOLEAN;
  54.     export_in    : TEXT;
  55.     export_out   : TEXT;
  56.     exec_char    : CHAR;
  57.     i            : INTEGER;
  58.     kill_sw      : BOOLEAN;
  59.     msg_ptr      : msg_index_ptr;
  60.     out_open     : BOOLEAN;
  61.     search_block : search_block_type;
  62.     save_ptr     : POINTER;
  63.     save_len     : WORD;
  64.     word_count   : BYTE;
  65.     work_word    : STRING[20];
  66.     x_msg_no     : LONGINT;
  67.  
  68.   (*=========================================================================*)
  69.   (* Cleanup detail                                                          *)
  70.   (*=========================================================================*)
  71.  
  72.   PROCEDURE export_clean;
  73.  
  74.     BEGIN;
  75.  
  76.       {$IFDEF DEBUG_1}
  77.         WRITELN('Clean export 1 -- ', out_open);
  78.       {$ENDIF}
  79.  
  80.       (*---------------------------------------------------------------------*)
  81.       (* Obtain the interrupt lock                                           *)
  82.       (*---------------------------------------------------------------------*)
  83.  
  84.       get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  85.  
  86.       (*---------------------------------------------------------------------*)
  87.       (* Close the output file if it is open                                 *)
  88.       (*---------------------------------------------------------------------*)
  89.  
  90.       IF out_open THEN
  91.         BEGIN;
  92.           {$I-}
  93.           CLOSE(export_out);
  94.           {$I+}
  95.           out_open := FALSE;
  96.         END;
  97.  
  98.       (*---------------------------------------------------------------------*)
  99.       (* Release the interrupt lock                                          *)
  100.       (*---------------------------------------------------------------------*)
  101.  
  102.       {$IFDEF DEBUG_1}
  103.         WRITELN('Clean export 2 -- ', out_open);
  104.       {$ENDIF}
  105.  
  106.       free_semaphore(semaphore_interrupts);
  107.  
  108.     END;
  109.  
  110.   (*=========================================================================*)
  111.   (* Export a single message                                                 *)
  112.   (*=========================================================================*)
  113.  
  114.   PROCEDURE export_a_msg (msg_ptr : msg_index_ptr);
  115.  
  116.     VAR
  117.       b           : BOOLEAN;
  118.       i           : INTEGER;
  119.       m_no        : STRING[5];
  120.       t_str       : STRING;
  121.  
  122.     BEGIN;
  123.  
  124.       {$IFDEF DEBUG_FILE2}
  125.         WRITELN('Open_check = ', out_open);
  126.       {$ENDIF}
  127.  
  128.       (*---------------------------------------------------------------------*)
  129.       (* If output file is not open then open it                             *)
  130.       (*---------------------------------------------------------------------*)
  131.  
  132.       IF NOT out_open THEN
  133.         BEGIN;
  134.  
  135.           (*-----------------------------------------------------------------*)
  136.           (* Obtain the interrupt lock                                       *)
  137.           (*-----------------------------------------------------------------*)
  138.  
  139.           get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  140.  
  141.           (*-----------------------------------------------------------------*)
  142.           (* Open output file.  Try append mode first and then rewrite.      *)
  143.           (*-----------------------------------------------------------------*)
  144.  
  145.           {$I-}
  146.           APPEND(export_out);
  147.           i := IORESULT;
  148.           {$I+}
  149.           IF i = 2 THEN
  150.             BEGIN;
  151.               {$I-}
  152.               REWRITE(export_out);
  153.               i := IORESULT;
  154.               {$I+}
  155.             END;
  156.           {$I+}
  157.  
  158.           {$IFDEF DEBUG_FILE2}
  159.             WRITELN('Open results = ', i);
  160.           {$ENDIF}
  161.  
  162.           (*-----------------------------------------------------------------*)
  163.           (* Release the interrupt lock                                      *)
  164.           (*-----------------------------------------------------------------*)
  165.  
  166.           free_semaphore(semaphore_interrupts);
  167.  
  168.           (*-----------------------------------------------------------------*)
  169.           (* Handle I/O error                                                *)
  170.           (*-----------------------------------------------------------------*)
  171.  
  172.           IF i <> 0 THEN
  173.             BEGIN;
  174.               IF i <> 2 THEN
  175.                 send_tnc_data_str(dos_err_message(i) + cr)
  176.               ELSE
  177.                 send_tnc_data_str('Invalid file name' + cr);
  178.               active_tcb^.error_sw := TRUE;
  179.               EXIT;
  180.             END;
  181.  
  182.           (*-----------------------------------------------------------------*)
  183.           (* Show open output file                                           *)
  184.           (*-----------------------------------------------------------------*)
  185.  
  186.           out_open := TRUE;
  187.  
  188.         END; (*----- End opening output file --------------------------------*)
  189.  
  190.       (*---------------------------------------------------------------------*)
  191.       (* Switch                                                              *)
  192.       (*---------------------------------------------------------------------*)
  193.  
  194.       task_switch;
  195.  
  196.       (*---------------------------------------------------------------------*)
  197.       (* Setup                                                               *)
  198.       (*---------------------------------------------------------------------*)
  199.  
  200.       active_tcb^.curr_msg := msg_ptr^;
  201.  
  202.       WITH msg_ptr^.msg_i_mb DO
  203.         BEGIN;
  204.  
  205.           (*-----------------------------------------------------------------*)
  206.           (* Build the send command                                          *)
  207.           (*-----------------------------------------------------------------*)
  208.  
  209.           t_str := 'S' + msg_type + ' ' + msg_to;
  210.  
  211.           IF msg_to_at <> '' THEN
  212.             BEGIN;
  213.               t_str := t_str + ' @ ' + msg_to_at;
  214.               IF msg_to_h <> '' THEN
  215.                 t_str := t_str + '.' + msg_to_h;
  216.             END;
  217.  
  218.           t_str := t_str + ' < ' + msg_from;
  219.  
  220.           IF msg_bid <> '' THEN
  221.             t_str := t_str + ' $' + msg_bid;
  222.  
  223.           (*-----------------------------------------------------------------*)
  224.           (* Write the send command                                          *)
  225.           (*-----------------------------------------------------------------*)
  226.  
  227.           WRITELN(export_out, t_str);
  228.  
  229.           (*-----------------------------------------------------------------*)
  230.           (* Write the subject                                               *)
  231.           (*-----------------------------------------------------------------*)
  232.  
  233.           WRITELN(export_out, msg_subj);
  234.  
  235.           (*-----------------------------------------------------------------*)
  236.           (* Do we write a header?                                           *)
  237.           (*-----------------------------------------------------------------*)
  238.  
  239.           IF add_header AND (NOT opt_block.opt_personal_bbs) THEN
  240.             BEGIN;
  241.  
  242.               (*-------------------------------------------------------------*)
  243.               (* Time zone correction to header is send in proper time       *)
  244.               (*-------------------------------------------------------------*)
  245.  
  246.               INC(active_tcb^.curr_msg.msg_i_mb.msg_dt_in,
  247.                                                      opt_block.z_time_fwd);
  248.               INC(active_tcb^.curr_msg.msg_i_mb.msg_dt_orig,
  249.                                                      opt_block.z_time_fwd);
  250.  
  251.               (*-------------------------------------------------------------*)
  252.               (* Send the new forward header line.                           *)
  253.               (*-------------------------------------------------------------*)
  254.  
  255.               IF ((msg_from_at = opt_block.this_bb_addr)
  256.                                           OR ((msg_flag AND mf_bid_change)<>0))
  257.                             AND NOT opt_block.opt_no_alt_header THEN
  258.                 t_str := get_message(message_alt_header)
  259.               ELSE
  260.                 t_str := get_message(message_fwd_head);
  261.  
  262.               WRITELN(export_out, t_str);
  263.  
  264.             END; (*----- End writing a header -------------------------------*)
  265.  
  266.           (*-----------------------------------------------------------------*)
  267.           (* Build the dataset name                                          *)
  268.           (*-----------------------------------------------------------------*)
  269.  
  270.           STR(msg_number, m_no);
  271.  
  272.           t_str := opt_block.msg_file_dir + 'BB' + m_no + '.MSG';
  273.  
  274.           (*-----------------------------------------------------------------*)
  275.           (* Open the file                                                   *)
  276.           (*-----------------------------------------------------------------*)
  277.  
  278.           ASSIGN(export_in, t_str);
  279.  
  280.           {$I-}
  281.           RESET(export_in);
  282.           {$I+}
  283.  
  284.           i := IORESULT;
  285.  
  286.           (*-----------------------------------------------------------------*)
  287.           (* Handle error on OPEN                                            *)
  288.           (*-----------------------------------------------------------------*)
  289.  
  290.           IF i <> 0 THEN
  291.             BEGIN;
  292.               t_str := t_str + ' -- ' + dos_err_message(i);
  293.               WRITELN(export_out, t_str);
  294.               send_tnc_data_str(t_str + cr);
  295.               active_tcb^.error_sw := TRUE;
  296.  
  297.               {$IFDEF DEBUG_1}
  298.                 WRITELN('Error set open -- ', out_open);
  299.               {$ENDIF}
  300.  
  301.               EXIT;
  302.             END;
  303.  
  304.           (*-----------------------------------------------------------------*)
  305.           (* Copy the file                                                   *)
  306.           (*-----------------------------------------------------------------*)
  307.  
  308.           b := TRUE;
  309.  
  310.           i := 0;
  311.  
  312.           WHILE NOT EOF(export_in) DO
  313.             BEGIN;
  314.  
  315.               IF i > 20 THEN
  316.                 BEGIN;
  317.                   task_switch;
  318.                   i := 0;
  319.                 END;
  320.  
  321.               b := EOLN(export_in);
  322.  
  323.               IF b THEN
  324.                 BEGIN;
  325.                   READLN(export_in, t_str);
  326.                   WRITELN(export_out, t_str);
  327.                 END
  328.               ELSE
  329.                 BEGIN;
  330.                   READ(export_in, t_str);
  331.                   WRITE(export_out, t_str);
  332.                 END;
  333.  
  334.             END;
  335.  
  336.           (*-----------------------------------------------------------------*)
  337.           (* Write the end of the file                                       *)
  338.           (*-----------------------------------------------------------------*)
  339.  
  340.           IF NOT b THEN
  341.             WRITELN(export_out);
  342.           WRITELN(export_out, '/EX');
  343.  
  344.           (*-----------------------------------------------------------------*)
  345.           (* Close up                                                        *)
  346.           (*-----------------------------------------------------------------*)
  347.  
  348.           CLOSE(export_in);
  349.  
  350.           (*-----------------------------------------------------------------*)
  351.           (* Flush the buffers                                               *)
  352.           (*-----------------------------------------------------------------*)
  353.  
  354.           flushdosfile(@export_out);
  355.  
  356.           (*-----------------------------------------------------------------*)
  357.           (* Report                                                          *)
  358.           (*-----------------------------------------------------------------*)
  359.  
  360.           send_tnc_data_str('Message ' + m_no + ' exported' + cr);
  361.  
  362.         END;
  363.  
  364.       (*---------------------------------------------------------------------*)
  365.       (* Kill as needed                                                      *)
  366.       (*---------------------------------------------------------------------*)
  367.  
  368.       IF kill_sw THEN
  369.         kill_a_msg(msg_ptr, TRUE);
  370.  
  371.     END; (*----- End export a single message --------------------------------*)
  372.  
  373.   (*=========================================================================*)
  374.   (* This is the code for exporting via a command search                     *)
  375.   (*=========================================================================*)
  376.  
  377.   PROCEDURE do_export;
  378.  
  379.     BEGIN;
  380.  
  381.       CASE exec_char OF
  382.  
  383.         (*-------------------------------------------------------------------*)
  384.         (* Export message by number                                          *)
  385.         (*-------------------------------------------------------------------*)
  386.  
  387.         '#' : BEGIN;
  388.  
  389.                (*------------------------------------------------------------*)
  390.                (* Check word count -- must have something after the #        *)
  391.                (*------------------------------------------------------------*)
  392.  
  393.                IF word_count < 4 THEN
  394.                  BEGIN;
  395.                    send_message(message_not_en);
  396.                    active_tcb^.error_sw := TRUE;
  397.                    EXIT;
  398.                  END;
  399.  
  400.                (*------------------------------------------------------------*)
  401.                (* Validate number                                            *)
  402.                (*------------------------------------------------------------*)
  403.  
  404.                upcase_str_var(cmd_string);
  405.  
  406.                check_multiple_msg(@cmd_string, 4, word_count);
  407.                IF active_tcb^.error_sw THEN
  408.                  EXIT;
  409.  
  410.                (*------------------------------------------------------------*)
  411.                (* Loop thru all the messages                                 *)
  412.                (*------------------------------------------------------------*)
  413.  
  414.                x_msg_no := get_next_multiple_msg;
  415.  
  416.                WHILE x_msg_no <> 0 DO
  417.                  BEGIN;
  418.  
  419.                    (*--------------------------------------------------------*)
  420.                    (* Fetch message pointer.  Give error if we can't find    *)
  421.                    (*--------------------------------------------------------*)
  422.  
  423.                    msg_ptr := find_msg(x_msg_no);
  424.  
  425.                    IF msg_ptr = NIL THEN
  426.                      BEGIN;
  427.  
  428.                        (*----------------------------------------------------*)
  429.                        (* Message not found!  Set the error switch           *)
  430.                        (*----------------------------------------------------*)
  431.  
  432.                        active_tcb^.error_sw := TRUE;
  433.  
  434.                        (*----------------------------------------------------*)
  435.                        (* Send proper message.  If more to do then continue  *)
  436.                        (*----------------------------------------------------*)
  437.  
  438.                        IF word_count = 4 THEN
  439.                          BEGIN;
  440.                            send_message(message_rmc_nf);
  441.                            EXIT;
  442.                          END
  443.                        ELSE
  444.                          BEGIN;
  445.                            STR(x_msg_no, work_word);
  446.                            set_dollar1_parm(@work_word);
  447.                            send_message(message_rmc_nf_wp);
  448.                          END;
  449.  
  450.                      END
  451.  
  452.                    ELSE
  453.  
  454.                      BEGIN;
  455.  
  456.                        (*----------------------------------------------------*)
  457.                        (* Message found so export it                         *)
  458.                        (*----------------------------------------------------*)
  459.  
  460.                        export_a_msg(msg_ptr);
  461.  
  462.                        (*----------------------------------------------------*)
  463.                        (* Handle error from export                           *)
  464.                        (*----------------------------------------------------*)
  465.  
  466.                        IF active_tcb^.error_sw THEN
  467.                          BEGIN;
  468.  
  469.                            {$IFDEF DEBUG_1}
  470.                              WRITELN('Error set in loop -- ', out_open);
  471.                            {$ENDIF}
  472.  
  473.                            send_message(message_op_halted);
  474.                            export_clean;
  475.                            EXIT;
  476.                          END;
  477.  
  478.                      END;
  479.  
  480.                    (*--------------------------------------------------------*)
  481.                    (* Get next message                                       *)
  482.                    (*--------------------------------------------------------*)
  483.  
  484.                    x_msg_no := get_next_multiple_msg;
  485.  
  486.                  END; (*----- End read multiple loop ------------------------*)
  487.  
  488.              END; (*----- End Export a certain message ----------------------*)
  489.  
  490.         (*-------------------------------------------------------------------*)
  491.         (* Handle all other letters                                          *)
  492.         (*-------------------------------------------------------------------*)
  493.  
  494.         ELSE
  495.           BEGIN;
  496.  
  497.             (*---------------------------------------------------------------*)
  498.             (* Get just the search portion of the command                    *)
  499.             (*---------------------------------------------------------------*)
  500.  
  501.             cmd_string := subword(@cmd_string, 3, 0);
  502.  
  503.             (*---------------------------------------------------------------*)
  504.             (* Build search blocks as needed.  Exit if error                 *)
  505.             (*---------------------------------------------------------------*)
  506.  
  507.             set_search(cmd_string, @search_block);
  508.             IF active_tcb^.error_sw THEN
  509.               EXIT;
  510.  
  511.             (*---------------------------------------------------------------*)
  512.             (* Search in the right sequence                                  *)
  513.             (*---------------------------------------------------------------*)
  514.  
  515.             IF NOT search_block.search_direction THEN
  516.               search_block.search_ascend := TRUE;
  517.  
  518.             (*---------------------------------------------------------------*)
  519.             (* Start the search                                              *)
  520.             (*---------------------------------------------------------------*)
  521.  
  522.             search_msg(@search_block);
  523.  
  524.             (*---------------------------------------------------------------*)
  525.             (* If nothing found, tell user and exit                          *)
  526.             (*---------------------------------------------------------------*)
  527.  
  528.             IF search_block.search_last = NIL THEN
  529.               BEGIN;
  530.                 send_message(message_lmc_nf);
  531.                 active_tcb^.error_sw := TRUE;
  532.                 EXIT;
  533.               END;
  534.  
  535.             (*---------------------------------------------------------------*)
  536.             (* Now loop around send the message info, searching for next unti*)
  537.             (*---------------------------------------------------------------*)
  538.  
  539.             WHILE search_block.search_last <> NIL DO
  540.               BEGIN;
  541.  
  542.                 {$IFDEF POINT_CHK}
  543.                   test_pointer(search_block.search_last);
  544.                 {$ENDIF}
  545.  
  546.                 (*-----------------------------------------------------------*)
  547.                 (* Export the message                                        *)
  548.                 (*-----------------------------------------------------------*)
  549.  
  550.                 export_a_msg(search_block.search_last);
  551.  
  552.                 (*-----------------------------------------------------------*)
  553.                 (* Handle errors from export                                 *)
  554.                 (*-----------------------------------------------------------*)
  555.  
  556.                 IF active_tcb^.error_sw THEN
  557.                   BEGIN;
  558.                     send_message(message_op_halted);
  559.                     EXIT;
  560.                   END;
  561.  
  562.                 (*-----------------------------------------------------------*)
  563.                 (* Search for next hit                                       *)
  564.                 (*-----------------------------------------------------------*)
  565.  
  566.                 search_msg(@search_block);
  567.  
  568.               END; (*----- End search loop ----------------------------------*)
  569.  
  570.           END; (*---- End hadling anything but "#" --------------------------*)
  571.  
  572.       END; (*----- End case statement on search type ------------------------*)
  573.  
  574.     END; (*---- End DO_EXPORT subroutine ------------------------------------*)
  575.  
  576.   (*=========================================================================*)
  577.   (* This is the code for exporting via an array                             *)
  578.   (*=========================================================================*)
  579.  
  580.   PROCEDURE do_export_array;
  581.  
  582.     VAR
  583.       i : BYTE;
  584.  
  585.     BEGIN;
  586.  
  587.       (*---------------------------------------------------------------------*)
  588.       (* Initialize                                                          *)
  589.       (*---------------------------------------------------------------------*)
  590.  
  591.       kill_sw    := FALSE;
  592.       add_header := TRUE;
  593.  
  594.       {$IFDEF POINT_CHK}
  595.         test_pointer(this_path);
  596.       {$ENDIF}
  597.  
  598.       (*---------------------------------------------------------------------*)
  599.       (* Set up addressing and prepare to loop                               *)
  600.       (*---------------------------------------------------------------------*)
  601.  
  602.       WITH this_path^ DO
  603.         BEGIN;
  604.  
  605.           {$IFDEF DEBUG_FILE}
  606.             WRITELN('Export array -- ', path_msg_count);
  607.           {$ENDIF}
  608.  
  609.           i := 0;
  610.  
  611.           (*-----------------------------------------------------------------*)
  612.           (* Loop thru all the messages                                      *)
  613.           (*-----------------------------------------------------------------*)
  614.  
  615.           WHILE i < path_msg_count DO
  616.             BEGIN;
  617.  
  618.               (*-------------------------------------------------------------*)
  619.               (* Bump loop counter                                           *)
  620.               (*-------------------------------------------------------------*)
  621.  
  622.               INC(i);
  623.  
  624.               {$IFDEF DEBUG_FILE}
  625.                 WRITELN('Export item -- ', i);
  626.               {$ENDIF}
  627.  
  628.               WITH path_msg_list^[i] DO
  629.                 BEGIN;
  630.  
  631.                   {$IFDEF POINT_CHK}
  632.                     test_pointer(msg_p_i);
  633.                   {$ENDIF}
  634.  
  635.                   active_tcb^.error_sw := FALSE;
  636.  
  637.                   (*---------------------------------------------------------*)
  638.                   (* Export this message                                     *)
  639.                   (*---------------------------------------------------------*)
  640.  
  641.                   export_a_msg(msg_p_i);
  642.  
  643.                   {$IFDEF POINT_CHK}
  644.                     test_pointer(msg_p_i);
  645.                   {$ENDIF}
  646.  
  647.                   (*---------------------------------------------------------*)
  648.                   (* Mark the message as forwarded                           *)
  649.                   (*---------------------------------------------------------*)
  650.  
  651.                   mark_as_forwarded(msg_p_i, msg_p_item, 'O');
  652.  
  653.                   (*---------------------------------------------------------*)
  654.                   (* Update the database                                     *)
  655.                   (*---------------------------------------------------------*)
  656.  
  657.                   update_msg(msg_p_i);
  658.  
  659.                   (*---------------------------------------------------------*)
  660.                   (* Prevent it from being redone                            *)
  661.                   (*---------------------------------------------------------*)
  662.  
  663.                   msg_p_i := NIL;
  664.  
  665.                 END; (*----- End addressability -----------------------------*)
  666.  
  667.             END; (*----- End loop thru the messages -------------------------*)
  668.  
  669.         END; (*----- End addressability of the path -------------------------*)
  670.  
  671.     END; (*----- End export of a path array ---------------------------------*)
  672.  
  673.   (*=========================================================================*)
  674.   (* Main line of export a message                                           *)
  675.   (*=========================================================================*)
  676.  
  677.   BEGIN;
  678.  
  679.     {$IFDEF DEBUG_FILE2}
  680.       WRITELN('Cmd = ', cmd_string);
  681.     {$ENDIF}
  682.  
  683.     (*-----------------------------------------------------------------------*)
  684.     (* Init                                                                  *)
  685.     (*-----------------------------------------------------------------------*)
  686.  
  687.     FILLCHAR(search_block, SIZEOF(search_block), #0);
  688.     search_block.search_nok    := TRUE;
  689.     search_block.search_ascend := TRUE;
  690.  
  691.     out_open := FALSE;
  692.  
  693.     add_header := FALSE;
  694.  
  695.     kill_sw    := FALSE;
  696.  
  697.     (*-----------------------------------------------------------------------*)
  698.     (* Get options (if any)                                                  *)
  699.     (*-----------------------------------------------------------------------*)
  700.  
  701.     work_word := get_option_string(cmd_string);
  702.  
  703.     upcase_str_var(work_word);
  704.  
  705.     (*-----------------------------------------------------------------------*)
  706.     (* Process options                                                       *)
  707.     (*-----------------------------------------------------------------------*)
  708.  
  709.     IF POS('K', work_word) > 0 THEN
  710.       kill_sw := TRUE;
  711.  
  712.     IF POS('H', work_word) > 0 THEN
  713.       add_header := TRUE;
  714.  
  715.     (*-----------------------------------------------------------------------*)
  716.     (* Parse front of command                                                *)
  717.     (*-----------------------------------------------------------------------*)
  718.  
  719.     word_count := WORDS(cmd_string);
  720.  
  721.     (*-----------------------------------------------------------------------*)
  722.     (* Check command format                                                  *)
  723.     (*-----------------------------------------------------------------------*)
  724.  
  725.     IF (word_count < 3) AND (this_path = NIL) THEN
  726.       BEGIN;
  727.         send_message(message_not_en);
  728.         active_tcb^.error_sw := TRUE;
  729.         EXIT;
  730.       END;
  731.  
  732.     (*-----------------------------------------------------------------------*)
  733.     (* Assign the file name now                                              *)
  734.     (*-----------------------------------------------------------------------*)
  735.  
  736.     ASSIGN(export_out, subword(@cmd_string, 2, 1));
  737.     {$IFDEF DEBUG_FILE2}
  738.       WRITELN('File = ', subword(@cmd_string, 2, 1));
  739.     {$ENDIF}
  740.  
  741.     (*-----------------------------------------------------------------------*)
  742.     (* Kill ?                                                                *)
  743.     (*-----------------------------------------------------------------------*)
  744.  
  745.     work_word := subword(@cmd_string, 1, 1);
  746.     upcase_str_var(work_word);
  747.     IF POS('K', work_word) > 0 THEN
  748.       kill_sw := TRUE;
  749.  
  750.     (*-----------------------------------------------------------------------*)
  751.     (* Execute right subroutine                                              *)
  752.     (*-----------------------------------------------------------------------*)
  753.  
  754.     work_word := subword(@cmd_string, 3, 1);
  755.     exec_char := work_word[1];
  756.  
  757.     work_word := subword(@cmd_string, 4, 1);
  758.     upcase_str_var(work_word);
  759.  
  760.     (*-----------------------------------------------------------------------*)
  761.     (* Execute the export                                                    *)
  762.     (*-----------------------------------------------------------------------*)
  763.  
  764.     IF this_path = NIL THEN
  765.       do_export
  766.     ELSE
  767.       do_export_array;
  768.  
  769.     (*-----------------------------------------------------------------------*)
  770.     (* Clean up                                                              *)
  771.     (*-----------------------------------------------------------------------*)
  772.  
  773.     export_clean;
  774.  
  775.     (*-----------------------------------------------------------------------*)
  776.     (* If successful, tell user                                              *)
  777.     (*-----------------------------------------------------------------------*)
  778.  
  779.     IF NOT active_tcb^.error_sw THEN
  780.       send_message(message_action_complete);
  781.  
  782.   END;
  783.  
  784. END.
  785.